nonlinearTseries::nonlinearityTest(actnetcrc, verbose = TRUE)
## ** Teraesvirta's neural network test **
## Null hypothesis: Linearity in "mean"
## X-squared = 1.495836 df = 2 p-value = 0.473351
##
## ** White neural network test **
## Null hypothesis: Linearity in "mean"
## X-squared = 1.313734 df = 2 p-value = 0.5184732
##
## ** Keenan's one-degree test for nonlinearity **
## Null hypothesis: The time series follows some AR process
## F-stat = 0.3879274 p-value = 0.5339872
##
## ** McLeod-Li test **
## Null hypothesis: The time series follows some ARIMA process
## Maximum p-value = 0
##
## ** Tsay's Test for nonlinearity **
## Null hypothesis: The time series follows some AR process
## F-stat = 1.665705 p-value = 0.1302654
##
## ** Likelihood ratio test for threshold nonlinearity **
## Null hypothesis: The time series follows some AR process
## Alternativce hypothesis: The time series follows some TAR process
## X-squared = 6.02467 p-value = 0.3262153
## $Terasvirta
##
## Teraesvirta Neural Network Test
##
## data: ts(time.series)
## X-squared = 1.4958, df = 2, p-value = 0.4734
##
##
## $White
##
## White Neural Network Test
##
## data: ts(time.series)
## X-squared = 1.3137, df = 2, p-value = 0.5185
##
##
## $Keenan
## $Keenan$test.stat
## [1] 0.3879274
##
## $Keenan$df1
## [1] 1
##
## $Keenan$df2
## [1] 238
##
## $Keenan$p.value
## [1] 0.5339872
##
## $Keenan$order
## [1] 3
##
##
## $McLeodLi
## $McLeodLi$p.values
## [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##
##
## $Tsay
## $Tsay$test.stat
## [1] 1.665705
##
## $Tsay$p.value
## [1] 0.1302654
##
## $Tsay$order
## [1] 3
##
##
## $TarTest
## $TarTest$percentiles
## [1] 24.69136 75.30864
##
## $TarTest$test.statistic
## [1] 6.02467
##
## $TarTest$p.value
## [1] 0.3262153
fNonlinear::tnnTest(actnetcrc, lag = 1, title = NULL, description = NULL)
##
## Title:
## Teraesvirta Neural Network Test
##
## Test Results:
## PARAMETER:
## lag: 1
## m|df: 2
## t-lag-m|df: 243
## STATISTIC:
## Chi-squared: 1.4958
## F: 0.741
## P VALUE:
## Chi-squared: 0.4734
## F: 0.4777
##
## Description:
## Sun Jan 2 09:32:47 2022 by user:
La hipótesis nula de que la serie de tiempo sigue algún proceso de AR.
Keenan.test(actnetcrc)
## $test.stat
## [1] 1.543471
##
## $p.value
## [1] 0.2153245
##
## $order
## [1] 3
Keenan.test(actnetcrc, order=1)
## $test.stat
## [1] 2.925783
##
## $p.value
## [1] 0.08845647
##
## $order
## [1] 1
Keenan.test(actnetcrc, order=2)
## $test.stat
## [1] 2.303251
##
## $p.value
## [1] 0.1304197
##
## $order
## [1] 2
Keenan.test(actnetcrc, order=3)
## $test.stat
## [1] 1.543471
##
## $p.value
## [1] 0.2153245
##
## $order
## [1] 3
bdsTest(actnetcrc)
##
## Title:
## BDS Test
##
## Test Results:
## PARAMETER:
## Max Embedding Dimension: 3
## eps[1]: 149998.2
## eps[2]: 299996.4
## eps[3]: 449994.6
## eps[4]: 599992.8
## STATISTIC:
## eps[1] m=2: 452.6032
## eps[1] m=3: 872.458
## eps[2] m=2: 124.0371
## eps[2] m=3: 165.3509
## eps[3] m=2: 61.6966
## eps[3] m=3: 66.5555
## eps[4] m=2: 50.4794
## eps[4] m=3: 50.3626
## P VALUE:
## eps[1] m=2: < 2.2e-16
## eps[1] m=3: < 2.2e-16
## eps[2] m=2: < 2.2e-16
## eps[2] m=3: < 2.2e-16
## eps[3] m=2: < 2.2e-16
## eps[3] m=3: < 2.2e-16
## eps[4] m=2: < 2.2e-16
## eps[4] m=3: < 2.2e-16
##
## Description:
## Sun Jan 2 09:32:47 2022 by user:
lag1.plot(actnetcrc, max.lag=12)
thr.test(actnetcrc)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 1 1
## F-ratio and p-value: 1.137518 0.3226488
thr.test(actnetcrc,p=2,d=1)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 2 1
## F-ratio and p-value: 0.56245 0.6403908
thr.test(actnetcrc,p=2,d=2)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 2 2
## F-ratio and p-value: 0.5674339 0.6370808
thr.test(actnetcrc,p=3,d=1)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 1
## F-ratio and p-value: 0.3389735 0.8514497
thr.test(actnetcrc,p=3,d=2)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 2
## F-ratio and p-value: 0.3073914 0.8728151
thr.test(actnetcrc,p=3,d=3)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 3
## F-ratio and p-value: 0.1618974 0.9573748
nonlinearTseries::nonlinearityTest(actnetusd, verbose = TRUE)
## ** Teraesvirta's neural network test **
## Null hypothesis: Linearity in "mean"
## X-squared = 0.4947052 df = 2 p-value = 0.7808653
##
## ** White neural network test **
## Null hypothesis: Linearity in "mean"
## X-squared = 0.7537214 df = 2 p-value = 0.6860116
##
## ** Keenan's one-degree test for nonlinearity **
## Null hypothesis: The time series follows some AR process
## F-stat = 0.09429519 p-value = 0.7590502
##
## ** McLeod-Li test **
## Null hypothesis: The time series follows some ARIMA process
## Maximum p-value = 0
##
## ** Tsay's Test for nonlinearity **
## Null hypothesis: The time series follows some AR process
## F-stat = 0.09895123 p-value = 0.7533629
##
## ** Likelihood ratio test for threshold nonlinearity **
## Null hypothesis: The time series follows some AR process
## Alternativce hypothesis: The time series follows some TAR process
## X-squared = 3.211571 p-value = 0.3061738
## $Terasvirta
##
## Teraesvirta Neural Network Test
##
## data: ts(time.series)
## X-squared = 0.49471, df = 2, p-value = 0.7809
##
##
## $White
##
## White Neural Network Test
##
## data: ts(time.series)
## X-squared = 0.75372, df = 2, p-value = 0.686
##
##
## $Keenan
## $Keenan$test.stat
## [1] 0.09429519
##
## $Keenan$df1
## [1] 1
##
## $Keenan$df2
## [1] 242
##
## $Keenan$p.value
## [1] 0.7590502
##
## $Keenan$order
## [1] 1
##
##
## $McLeodLi
## $McLeodLi$p.values
## [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##
##
## $Tsay
## $Tsay$test.stat
## [1] 0.09895123
##
## $Tsay$p.value
## [1] 0.7533629
##
## $Tsay$order
## [1] 1
##
##
## $TarTest
## $TarTest$percentiles
## [1] 24.89796 75.10204
##
## $TarTest$test.statistic
## [1] 3.211571
##
## $TarTest$p.value
## [1] 0.3061738
fNonlinear::tnnTest(actnetusd, lag = 1, title = NULL, description = NULL)
##
## Title:
## Teraesvirta Neural Network Test
##
## Test Results:
## PARAMETER:
## lag: 1
## m|df: 2
## t-lag-m|df: 243
## STATISTIC:
## Chi-squared: 0.4947
## F: 0.2446
## P VALUE:
## Chi-squared: 0.7809
## F: 0.7832
##
## Description:
## Sun Jan 2 09:32:52 2022 by user:
La hipótesis nula de que la serie de tiempo sigue algún proceso de AR.
Keenan.test(actnetusd)
## $test.stat
## [1] 0.946225
##
## $p.value
## [1] 0.3316533
##
## $order
## [1] 1
Keenan.test(actnetusd, order=1)
## $test.stat
## [1] 0.946225
##
## $p.value
## [1] 0.3316533
##
## $order
## [1] 1
Keenan.test(actnetusd, order=2)
## $test.stat
## [1] 0.7711585
##
## $p.value
## [1] 0.3807372
##
## $order
## [1] 2
Keenan.test(actnetusd, order=3)
## $test.stat
## [1] 0.4338976
##
## $p.value
## [1] 0.5107194
##
## $order
## [1] 3
bdsTest(actnetusd)
##
## Title:
## BDS Test
##
## Test Results:
## PARAMETER:
## Max Embedding Dimension: 3
## eps[1]: 222.772
## eps[2]: 445.544
## eps[3]: 668.316
## eps[4]: 891.088
## STATISTIC:
## eps[1] m=2: 493.7605
## eps[1] m=3: 932.8523
## eps[2] m=2: 128.601
## eps[2] m=3: 168.0983
## eps[3] m=2: 63.0738
## eps[3] m=3: 67.5475
## eps[4] m=2: 51.3731
## eps[4] m=3: 50.975
## P VALUE:
## eps[1] m=2: < 2.2e-16
## eps[1] m=3: < 2.2e-16
## eps[2] m=2: < 2.2e-16
## eps[2] m=3: < 2.2e-16
## eps[3] m=2: < 2.2e-16
## eps[3] m=3: < 2.2e-16
## eps[4] m=2: < 2.2e-16
## eps[4] m=3: < 2.2e-16
##
## Description:
## Sun Jan 2 09:32:52 2022 by user:
lag1.plot(actnetusd, max.lag=12)
thr.test(actnetusd)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 1 1
## F-ratio and p-value: 0.3290875 0.7199632
thr.test(actnetusd,p=2,d=1)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 2 1
## F-ratio and p-value: 0.270361 0.8467241
thr.test(actnetusd,p=2,d=2)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 2 2
## F-ratio and p-value: 0.2056243 0.8924247
thr.test(actnetusd,p=3,d=1)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 1
## F-ratio and p-value: 0.1718436 0.9526018
thr.test(actnetusd,p=3,d=2)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 2
## F-ratio and p-value: 0.1352353 0.969191
thr.test(actnetusd,p=3,d=3)
## SETAR model is entertained
## Threshold nonlinearity test for (p,d): 3 3
## F-ratio and p-value: 0.2117609 0.931694
# m orden
pm <- 1:3
mod.list.tar<-list()
AIC.best.list<-list()
AICM = NULL
model.best <- list(d=0, p1=0, p2=0)
AIC.best = 2888
for(l in pm){
for(j in pm){
for(i in pm){
set.seed(777)
model.tar.s = tar(sactnetcrc_train,p1=j,p2=i,d=l)
mod.list.tar[[paste(j,i,l,sep="-")]]<-model.tar.s$AIC
#print(paste(j,i,l,sep="-"))
if (model.tar.s$AIC < AIC.best) {
AIC.best = model.tar.s$AIC
AIC.best.list[[paste(j,i,l,sep="-")]]<-AIC.best
#print(AIC.best)
model.best$d = l
model.best$p1 = model.tar.s$p1
model.best$p2 = model.tar.s$p2
print(paste(model.tar.s$p1,model.tar.s$p2,l,sep="-")) }
}
}
}
# AICTar<-bind_rows(mod.list.tar,.id = "Ordene-delay")%>%
# arrange(`1`)
#
# knitr::kable(head(AICTar,20))
AICTarBest<-bind_rows(AIC.best.list,.id = "Ordene-delay")%>%
arrange(`1`)
knitr::kable(head(AICTarBest,20))
mod.tar1<-TSA::tar(sactnetcrc_train,p1=2,p2=3,d=1)
mod.tar2<-TSA::tar(sactnetcrc_train,p1=3,p2=1,d=1)
mod.tar3<-TSA::tar(sactnetcrc_train,p1=3,p2=2,d=1)
mod.tar1$thd
##
## 778351.5
mod.tar2$thd
##
## 634783.1
mod.tar3$thd
##
## 778351.5
mod.tar1$qr1$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## 1.133239e+04 8.135618e-01
## lag2-sactnetcrc_train
## 1.841392e-01
mod.tar2$qr1$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## 21868.4352666 0.7499834
## lag2-sactnetcrc_train lag3-sactnetcrc_train
## -0.3430847 0.5609114
mod.tar3$qr1$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## 4895.78533430 0.78566926
## lag2-sactnetcrc_train lag3-sactnetcrc_train
## -0.07458825 0.29804232
mod.tar1$qr2$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## -2.856838e+05 2.250800e+00
## lag2-sactnetcrc_train
## -1.029562e+00
mod.tar2$qr2$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## 9.180235e+04 8.826022e-01
mod.tar3$qr2$coefficients
## intercept-sactnetcrc_train lag1-sactnetcrc_train
## -2.856838e+05 2.250800e+00
## lag2-sactnetcrc_train
## -1.029562e+00
cbind(
Modelo=c("p1=2,p2=3,d=1",
"p1=3,p2=1,d=1",
"p1=3,p2=2,d=1"),
AIC=c(mod.tar1$AIC,
mod.tar2$AIC,
mod.tar3$AIC))%>%
knitr::kable()
| Modelo | AIC | |
|---|---|---|
| 1 | p1=2,p2=3,d=1 | 2880 |
| 1 | p1=3,p2=1,d=1 | 2878 |
| 1 | p1=3,p2=2,d=1 | 2873 |
#tsdiag(mod.tar1)
tsdiag(mod.tar2)
#tsdiag(mod.tar3)
checkresiduals(ts(mod.tar1$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
checkresiduals(ts(mod.tar2$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
checkresiduals(ts(mod.tar3$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
prontar1<- ts(as.vector(predict(mod.tar1,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar2<- ts(as.vector(predict(mod.tar2,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar3<- ts(as.vector(predict(mod.tar3,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
fit1<-ts(as.vector(mod.tar1$y)-as.vector(mod.tar1$residuals),start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1$y) - as.vector(mod.tar1$residuals): longer object
## length is not a multiple of shorter object length
fit2<-ts(sactnetcrc_train-mod.tar2$residuals,start =c(2011,1),frequency = 12)
## Warning in `-.default`(sactnetcrc_train, mod.tar2$residuals): longer object
## length is not a multiple of shorter object length
fit3<-ts(sactnetcrc_train-mod.tar3$residuals,start =c(2011,1),frequency = 12)
## Warning in `-.default`(sactnetcrc_train, mod.tar3$residuals): longer object
## length is not a multiple of shorter object length
autoplot(sactnetcrc_train)+
autolayer(fit1)+
autolayer(fit2)+
autolayer(fit3)+
theme_bw()
Metrics::rmse(sactnetcrc_test, prontar1)
## [1] 294161.5
Metrics::rmse(sactnetcrc_test, prontar2)
## [1] 139594.6
Metrics::rmse(sactnetcrc_test, prontar3)
## [1] 257694.2
autoplot(sactnetcrc_test)+
autolayer(prontar1)+
autolayer(prontar2)+
autolayer(prontar3)+
theme_bw()+
scale_y_continuous(limits = c(500000,1400000))
Thus the threshold delay, the number of lags in each regime and the threshold value are computed.
Setar1 <-
selectSETAR(
sactnetcrc_train,
include = c("const", "trend","none", "both"),
m = 3,
thDelay = seq(1, 2, by = 1),
nthresh = 2,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar2 <-
selectSETAR(
sactnetcrc_train,
m = 3,
d=2,
thDelay = seq(1, 2, by = 1),
nthresh = 2,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar3 <-
selectSETAR(
sactnetcrc_train,
m = 3,
thDelay = seq(0, 2, by = 1),
nthresh = 1,
d = 1,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar4 <-
selectSETAR(
sactnetcrc_train,
m = 3,
thDelay = seq(0, 2, by = 1),
nthresh = 1,
d = 2,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar1$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar2$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar3$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar4$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
modeloas1 <-
setar(
sactnetcrc_train,
m = 3,
mL = 3,
mH = 1,
d=1,
nthresh = 1,
thDelay = 2,
type = "level"
)
##
## 1 T: Trim not respected: 0.8632479 0.1367521 from th: 770561.5
## Warning: Possible unit root in the low regime. Roots are: 0.9958 1.4296 1.4296
## Raiz Unitaria
summary(modeloas1) #residuals variance = 0.005525, AIC = -632, MAPE = 0.4352%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2 phiL.3
## 6788.2145658 0.8298233 -0.3141401 0.4914032
##
## High regime:
## const.H phiH.1
## 6.258059e+04 9.301118e-01
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (0)X(t-1)+ (1)X(t-2)
## -Value: 730318
## Proportion of points in low regime: 74.36% High regime: 25.64%
##
## Residuals:
## Min 1Q Median 3Q Max
## -153164.6 -31930.4 -1978.2 28529.5 169203.7
##
## Fit:
## residuals variance = 2.669e+09, AIC = 2619, MAPE = 6.397%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 6.7882e+03 2.6284e+04 0.2583 0.79667
## phiL.1 8.2982e-01 1.2260e-01 6.7686 5.923e-10 ***
## phiL.2 -3.1414e-01 1.6136e-01 -1.9469 0.05401 .
## phiL.3 4.9140e-01 1.1942e-01 4.1150 7.347e-05 ***
## const.H 6.2581e+04 5.6979e+04 1.0983 0.27438
## phiH.1 9.3011e-01 6.9313e-02 13.4190 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (0) X(t-1)+ (1) X(t-2)
##
## Value: 730318
# plot(modeloas1)
checkresiduals(ts(modeloas1$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas2 <-
setar(
sactnetcrc_train,
m = 3,
mL = 2,
mH = 3,
d=2,
nthresh = 1,
thDelay = 2,
type = "level"
)
##
## 1 T: Trim not respected: 0.8508772 0.1491228 from th: 763482.7
## 1 T: Trim not respected: 0.8596491 0.1403509 from th: 765999.6
## 1 T: Trim not respected: 0.877193 0.122807 from th: 768336.6
## Warning: Possible unit root in the high regime. Roots are: 0.8544 1.0679 1.0679
## Warning: Possible unit root in the low regime. Roots are: 0.9985 1.9337
## Raiz Unitaria
summary(modeloas2) # residuals variance = 0.005857, AIC = -635, MAPE = 0.4584%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2
## 1.596903e+04 4.843835e-01 5.179294e-01
##
## High regime:
## const.H phiH.1 phiH.2 phiH.3
## -3.459287e+05 5.219453e-01 -1.177826e-01 1.026279e+00
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (0)X(t-1)+ (1)X(t-2)
## -Value: 743290
## Proportion of points in low regime: 79.82% High regime: 20.18%
##
## Residuals:
## Min 1Q Median 3Q Max
## -173908 -41385 -2497 44119 191478
##
## Fit:
## residuals variance = 4.159e+09, AIC = 2674, MAPE = 8.046%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 1.5969e+04 2.9655e+04 0.5385 0.59129
## phiL.1 4.8438e-01 1.0049e-01 4.8202 4.503e-06 ***
## phiL.2 5.1793e-01 1.0345e-01 5.0064 2.059e-06 ***
## const.H -3.4593e+05 2.2883e+05 -1.5117 0.13340
## phiH.1 5.2195e-01 2.0755e-01 2.5147 0.01332 *
## phiH.2 -1.1778e-01 2.0588e-01 -0.5721 0.56840
## phiH.3 1.0263e+00 3.9780e-01 2.5799 0.01117 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (0) X(t-1)+ (1) X(t-2)
##
## Value: 743290
# plot(modeloas2)
checkresiduals(ts(modeloas2$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas3 <-
setar(
sactnetcrc_train,
m = 3,
mL = 3,
mH = 2,
d=1,
nthresh = 1,
thDelay = 0,
type = "level"
)
## Warning: Possible unit root in the high regime. Roots are: 0.7777 1.5287
## Warning: Possible unit root in the low regime. Roots are: 0.9837 1.736 1.736
## Raiz Unitaria
summary(modeloas3) # residuals variance = 0.006319, AIC = -621, MAPE = 0.4621%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2 phiL.3
## -3220.1735591 0.8068262 -0.1186698 0.3373163
##
## High regime:
## const.H phiH.1 phiH.2
## -1.530389e+05 1.939965e+00 -8.411220e-01
##
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 766324
## Proportion of points in low regime: 82.91% High regime: 17.09%
##
## Residuals:
## Min 1Q Median 3Q Max
## -195426.8 -26217.0 -6775.5 30310.5 159633.0
##
## Fit:
## residuals variance = 2.394e+09, AIC = 2608, MAPE = 6.077%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L -3.2202e+03 2.3624e+04 -0.1363 0.8918211
## phiL.1 8.0683e-01 1.0141e-01 7.9561 1.500e-12 ***
## phiL.2 -1.1867e-01 1.3459e-01 -0.8817 0.3798108
## phiL.3 3.3732e-01 1.0782e-01 3.1284 0.0022358 **
## const.H -1.5304e+05 8.2622e+04 -1.8523 0.0665944 .
## phiH.1 1.9400e+00 2.5176e-01 7.7058 5.452e-12 ***
## phiH.2 -8.4112e-01 2.2778e-01 -3.6926 0.0003434 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
##
## Value: 766324
# plot(modeloas3)
checkresiduals(ts(modeloas3$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas4 <-
setar(
sactnetcrc_train,
m = 3,
mL = 1,
mH = 2,
d=2,
nthresh = 1,
thDelay = 0,
type = "level"
)
summary(modeloas4) # residuals variance = 0.006319, AIC = -621, MAPE = 0.4621%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1
## 497047.101814 -0.245272
##
## High regime:
## const.H phiH.1 phiH.2
## 4.872806e+04 6.017097e-01 3.500140e-01
##
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 438446
## Proportion of points in low regime: 17.54% High regime: 82.46%
##
## Residuals:
## Min 1Q Median 3Q Max
## -161045 -39211 -5795 36633 192910
##
## Fit:
## residuals variance = 4.642e+09, AIC = 2683, MAPE = 7.938%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 4.9705e+05 2.3095e+05 2.1522 0.0334753 *
## phiL.1 -2.4527e-01 5.9323e-01 -0.4135 0.6800454
## const.H 4.8728e+04 3.9998e+04 1.2183 0.2256210
## phiH.1 6.0171e-01 9.2488e-02 6.5058 2.091e-09 ***
## phiH.2 3.5001e-01 9.8458e-02 3.5550 0.0005498 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
##
## Value: 438446
# plot(modeloas4)
checkresiduals(ts(modeloas4$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
AIC(modeloas1)
## [1] 2618.596
AIC(modeloas2)
## [1] 2673.823
AIC(modeloas3)
## [1] 2607.529
AIC(modeloas4)
## [1] 2683.013
pronsetar1<- predict(modeloas1, n.ahead = 7)
pronsetar2<- predict(modeloas2, n.ahead = 7)
pronsetar3<- predict(modeloas3, n.ahead = 7)
pronsetar4<- predict(modeloas4, n.ahead = 7)
fit1<-ts(modeloas1$fitted.values,start =c(2011,1),frequency = 12)
fit2<-ts(modeloas2$fitted.values,start =c(2011,1),frequency = 12)
fit3<-ts(modeloas3$fitted.values,start =c(2011,1),frequency = 12)
fit4<-ts(modeloas4$fitted.values,start =c(2011,1),frequency = 12)
autoplot(sactnetcrc_train)+
autolayer(fit1)+
autolayer(fit2)+
autolayer(fit3)+
autolayer(fit4)+
theme_bw()
data.frame(
Modelo= c(
"1) m = 3,mL = 3,mH = 1, d=1",
"2) m = 3,mL = 2,mH = 3, d=2",
"3) m = 3,mL = 3,mH = 2, d=1",
"4) m = 3,mL = 1,mH = 2, d=2"
),
RMSE=c(
Metrics::rmse(sactnetcrc_test, pronsetar1),
Metrics::rmse(sactnetcrc_test, pronsetar2),
Metrics::rmse(sactnetcrc_test, pronsetar3),
Metrics::rmse(sactnetcrc_test, pronsetar4)))%>%
arrange(RMSE)%>%
knitr::kable()
| Modelo | RMSE |
|---|---|
| 4) m = 3,mL = 1,mH = 2, d=2 | 80934.83 |
| 1) m = 3,mL = 3,mH = 1, d=1 | 97545.73 |
| 2) m = 3,mL = 2,mH = 3, d=2 | 245685.71 |
| 3) m = 3,mL = 3,mH = 2, d=1 | 313915.21 |
autoplot(sactnetcrc_test)+
autolayer(pronsetar1)+
autolayer(pronsetar2)+
autolayer(pronsetar3)+
autolayer(pronsetar4)+
theme_bw()+
scale_y_continuous(limits = c(500000,1400000))
Metrics::rmse(sactnetcrc_test,(prontar2))
Metrics::rmse(sactnetcrc_test, (pronsetar4))
autoplot(sactnetcrc_test)+
autolayer(prontar2)+
autolayer(pronsetar4)+
theme_bw()+
scale_y_continuous(limits = c(500000,1400000))
# m orden
pm <- 1:4
mod.list.tar<-list()
AIC.best.list<-list()
AICM = NULL
model.best <- list(d=0, p1=0, p2=0)
AIC.best = 10000
for(l in pm){
for(j in pm){
for(i in pm){
set.seed(777)
model.tar.s = tar(sactnetusd_train,p1=j,p2=i,d=l)
mod.list.tar[[paste(j,i,l,sep="-")]]<-model.tar.s$AIC
print(paste("Modelo:",j,i,l,sep="-"))
if (model.tar.s$AIC < AIC.best) {
AIC.best = model.tar.s$AIC
AIC.best.list[[paste(j,i,l,sep="-")]]<-AIC.best
#print("Modelo:",j,i,l,"AIC",AIC.best)
model.best$d = l
model.best$p1 = model.tar.s$p1
model.best$p2 = model.tar.s$p2
print(paste(model.tar.s$p1,model.tar.s$p2,l,sep="-")) }
}
}
}
# AICTar<-bind_rows(mod.list.tar,.id = "Ordene-delay")%>%
# arrange(`1`)
#
# knitr::kable(head(AICTar,20))
AICTarBest<-bind_rows(AIC.best.list,.id = "Ordene-delay")%>%
arrange(`1`)
knitr::kable(head(AICTarBest,20))
mod.tar1.usd<-TSA::tar(sactnetusd_train,p1=3,p2=4,d=1)
mod.tar2.usd<-TSA::tar(sactnetusd_train,p1=1,p2=2,d=1)
mod.tar3.usd<-TSA::tar(sactnetusd_train,p1=1,p2=3,d=1)
mod.tar1.usd$thd
##
## 622.0209
mod.tar2.usd$thd
##
## 670.8907
mod.tar3.usd$thd
##
## 691.3097
mod.tar1.usd$qr1$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 181.4332347 1.6151098
## lag2-sactnetusd_train lag3-sactnetusd_train
## -1.3676001 0.4599062
mod.tar2.usd$qr1$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 166.0529509 0.7379237
mod.tar3.usd$qr1$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 132.9783554 0.7962717
mod.tar1.usd$qr2$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 65.0189187 0.9439411
mod.tar2.usd$qr2$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 83.4616216 0.9278156
mod.tar3.usd$qr2$coefficients
## intercept-sactnetusd_train lag1-sactnetusd_train
## 108.7318363 0.9060299
data.frame(
Modelo=c("p1=3,p2=4,d=1",
"p1=1,p2=2,d=1",
"p1=1,p2=3,d=1"),
AIC=c(mod.tar1.usd$AIC,
mod.tar2.usd$AIC,
mod.tar3.usd$AIC))%>%
arrange(AIC)%>%
knitr::kable()
| Modelo | AIC |
|---|---|
| p1=3,p2=4,d=1 | 1323 |
| p1=1,p2=3,d=1 | 1346 |
| p1=1,p2=2,d=1 | 1357 |
tsdiag(mod.tar1.usd)
tsdiag(mod.tar2.usd)
tsdiag(mod.tar3.usd)
checkresiduals(ts(mod.tar1.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
checkresiduals(ts(mod.tar2.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
checkresiduals(ts(mod.tar3.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
prontar1.usd<- ts(as.vector(predict(mod.tar1.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar2.usd<- ts(as.vector(predict(mod.tar2.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar3.usd<- ts(as.vector(predict(mod.tar3.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
fit1.usd<-ts(as.vector(mod.tar1.usd$y)-as.vector(mod.tar1.usd$residuals),start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - as.vector(mod.tar1.usd$residuals): longer
## object length is not a multiple of shorter object length
fit2.usd<-ts(as.vector(mod.tar1.usd$y)-mod.tar2.usd$residuals,start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - mod.tar2.usd$residuals: longer object
## length is not a multiple of shorter object length
fit3.usd<-ts(as.vector(mod.tar1.usd$y)-mod.tar3.usd$residuals,start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - mod.tar3.usd$residuals: longer object
## length is not a multiple of shorter object length
autoplot(sactnetusd_train)+
autolayer(fit1.usd)+
autolayer(fit2.usd)+
autolayer(fit3.usd)+
theme_bw()
data.frame(
Modelo=c("p1=3,p2=4,d=1",
"p1=1,p2=2,d=1",
"p1=1,p2=3,d=1"),
RMSE=c(
Metrics::rmse(sactnetusd_test, prontar1.usd),
Metrics::rmse(sactnetusd_test, prontar2.usd),
Metrics::rmse(sactnetusd_test, prontar3.usd)))%>%
arrange(RMSE)%>%
knitr::kable()
| Modelo | RMSE |
|---|---|
| p1=3,p2=4,d=1 | 329.1884 |
| p1=1,p2=2,d=1 | 351.2767 |
| p1=1,p2=3,d=1 | 371.4562 |
autoplot(sactnetusd_test)+
autolayer(prontar1.usd)+
autolayer(prontar2.usd)+
autolayer(prontar3.usd)+
theme_bw()
Thus the threshold delay, the number of lags in each regime and the threshold value are computed.
Setar1.usd <-
selectSETAR(
sactnetusd_train,
include = c("const", "trend","none", "both"),
m = 4,
thDelay = seq(0, 3, by = 1),
nthresh = 3,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar2.usd <-
selectSETAR(
sactnetusd_train,
m = 4,
d=2,
thDelay = seq(0, 3 by = 1),
nthresh = 3,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar3.usd <-
selectSETAR(
sactnetusd_train,
m = 4,
thDelay = seq(0, 3, by = 1),
nthresh = 3,
d = 1,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar4.usd <-
selectSETAR(
sactnetusd_train,
m = 4,
thDelay = seq(0, 3, by = 1),
nthresh = 3,
d = 2,
criterion = "AIC",
type = "level",
plot = T,
trace = T
)
Setar1.usd$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar2.usd$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar3.usd$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
Setar4.usd$allTh%>%
as.data.frame()%>%
arrange(AIC,thDelay,mL,mH)%>%
head(5)
modeloas1.usd <-
setar(
sactnetusd_train,
mL = 1,
mH = 1,
d=1,
nthresh = 1,
thDelay = 1,
type = "level"
)
##
## 1 T: Trim not respected: 0.8559322 0.1440678 from th: 1212.776
## Warning: Possible unit root in the high regime. Roots are: 0.926
## Warning: Possible unit root in the low regime. Roots are: 0.9973
## Raiz Unitaria
summary(modeloas1.usd) #residuals variance = 0.005525, AIC = -632, MAPE = 0.4352%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1
## 14.375566 1.002708
##
## High regime:
## const.H phiH.1
## -139.242572 1.079965
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 1203
## Proportion of points in low regime: 81.36% High regime: 18.64%
##
## Residuals:
## Min 1Q Median 3Q Max
## -143.9335 -53.2829 -5.4996 50.1964 240.7517
##
## Fit:
## residuals variance = 5265, AIC = 1038, MAPE = 6.015%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 14.375566 33.188627 0.4331 0.6657
## phiL.1 1.002708 0.034585 28.9927 < 2.2e-16 ***
## const.H -139.242572 155.823087 -0.8936 0.3734
## phiH.1 1.079965 0.121916 8.8583 1.111e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 1203
# plot(modeloas1)
checkresiduals(ts(modeloas1.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas2.usd <-
setar(
sactnetusd_train,
mL = 3,
mH = 1,
d=2,
nthresh = 1,
thDelay = 1,
type = "level"
)
##
## 1 T: Trim not respected: 0.8596491 0.1403509 from th: 1212.381
## Warning: Possible unit root in the low regime. Roots are: 0.9303 1.143 0.9303
## Raiz Unitaria
summary(modeloas2.usd) # residuals variance = 0.005857, AIC = -635, MAPE = 0.4584%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2 phiL.3
## 858.2495437 0.5731090 0.1113798 -1.0108432
##
## High regime:
## const.H phiH.1
## 258.7562047 0.7787606
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)+ (0)X(t-2)
## -Value: 785.8
## Proportion of points in low regime: 22.81% High regime: 77.19%
##
## Residuals:
## Min 1Q Median 3Q Max
## -267.8547 -64.4825 -8.4419 55.1728 308.2301
##
## Fit:
## residuals variance = 8762, AIC = 1103, MAPE = 7.549%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 858.249544 248.319565 3.4562 0.0007705 ***
## phiL.1 0.573109 0.195945 2.9249 0.0041589 **
## phiL.2 0.111380 0.308654 0.3609 0.7188742
## phiL.3 -1.010843 0.297348 -3.3995 0.0009310 ***
## const.H 258.756205 76.771445 3.3705 0.0010249 **
## phiH.1 0.778761 0.068832 11.3140 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)+ (0) X(t-2)
##
## Value: 785.8
# plot(modeloas2)
checkresiduals(ts(modeloas2.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas3.usd <-
setar(
sactnetusd_train,
mL = 1,
mH = 1,
d=1,
nthresh = 1,
thDelay = 1,
type = "level"
)
##
## 1 T: Trim not respected: 0.8559322 0.1440678 from th: 1212.776
## Warning: Possible unit root in the high regime. Roots are: 0.926
## Warning: Possible unit root in the low regime. Roots are: 0.9973
## Raiz Unitaria
summary(modeloas3.usd) # residuals variance = 0.006319, AIC = -621, MAPE = 0.4621%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1
## 14.375566 1.002708
##
## High regime:
## const.H phiH.1
## -139.242572 1.079965
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 1203
## Proportion of points in low regime: 81.36% High regime: 18.64%
##
## Residuals:
## Min 1Q Median 3Q Max
## -143.9335 -53.2829 -5.4996 50.1964 240.7517
##
## Fit:
## residuals variance = 5265, AIC = 1038, MAPE = 6.015%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 14.375566 33.188627 0.4331 0.6657
## phiL.1 1.002708 0.034585 28.9927 < 2.2e-16 ***
## const.H -139.242572 155.823087 -0.8936 0.3734
## phiH.1 1.079965 0.121916 8.8583 1.111e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 1203
# plot(modeloas3)
checkresiduals(ts(modeloas3.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
modeloas4.usd <-
setar(
sactnetusd_train,
m = 3,
mL = 1,
mH = 2,
d=2,
nthresh = 1,
thDelay = 0,
type = "level"
)
## Warning: Possible unit root in the high regime. Roots are: 0.8301 6.3855
## Warning: Possible unit root in the low regime. Roots are: 0.9875
summary(modeloas4.usd) # residuals variance = 0.006319, AIC = -621, MAPE = 0.4621%
##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1
## 22.905069 1.012612
##
## High regime:
## const.H phiH.1 phiH.2
## -351.2749796 1.0481121 0.1886645
##
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 1193
## Proportion of points in low regime: 78.95% High regime: 21.05%
##
## Residuals:
## Min 1Q Median 3Q Max
## -234.1334 -76.6856 2.1224 61.6316 277.0180
##
## Fit:
## residuals variance = 9172, AIC = 1107, MAPE = 8.311%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 22.905069 47.818727 0.4790 0.6328
## phiL.1 1.012612 0.050424 20.0821 < 2.2e-16 ***
## const.H -351.274980 251.367333 -1.3975 0.1650
## phiH.1 1.048112 0.246488 4.2522 4.33e-05 ***
## phiH.2 0.188664 0.192645 0.9793 0.3295
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
##
## Value: 1193
# plot(modeloas4)
checkresiduals(ts(modeloas4.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.
AIC(modeloas1.usd)
## [1] 1038.25
AIC(modeloas2.usd)
## [1] 1103.381
AIC(modeloas3.usd)
## [1] 1038.25
AIC(modeloas4.usd)
## [1] 1106.873
pronsetar1.usd<- predict(modeloas1.usd, n.ahead = 7)
pronsetar2.usd<- predict(modeloas2.usd, n.ahead = 7)
pronsetar3.usd<- predict(modeloas3.usd, n.ahead = 7)
pronsetar4.usd<- predict(modeloas4.usd, n.ahead = 7)
fit1.usd<-ts(modeloas1.usd$fitted.values,start =c(2011,1),frequency = 12)
fit2.usd<-ts(modeloas2.usd$fitted.values,start =c(2011,1),frequency = 12)
fit3.usd<-ts(modeloas3.usd$fitted.values,start =c(2011,1),frequency = 12)
fit4.usd<-ts(modeloas4.usd$fitted.values,start =c(2011,1),frequency = 12)
autoplot(sactnetusd_train)+
autolayer(fit1.usd)+
autolayer(fit2.usd)+
autolayer(fit3.usd)+
autolayer(fit4.usd)+
theme_bw()
data.frame(
Modelo= c(
"1) m = 3,mL = 3,mH = 1, d=1",
"2) m = 3,mL = 2,mH = 3, d=2",
"3) m = 3,mL = 3,mH = 2, d=1",
"4) m = 3,mL = 1,mH = 2, d=2"
),
RMSE=c(
Metrics::rmse(sactnetusd_test, pronsetar1.usd),
Metrics::rmse(sactnetusd_test, pronsetar2.usd),
Metrics::rmse(sactnetusd_test, pronsetar3.usd),
Metrics::rmse(sactnetusd_test, pronsetar4.usd)))%>%
arrange(RMSE)%>%
knitr::kable()
| Modelo | RMSE |
|---|---|
| 4) m = 3,mL = 1,mH = 2, d=2 | 269.2250 |
| 1) m = 3,mL = 3,mH = 1, d=1 | 380.1196 |
| 3) m = 3,mL = 3,mH = 2, d=1 | 380.1196 |
| 2) m = 3,mL = 2,mH = 3, d=2 | 389.9989 |
autoplot(sactnetusd_test)+
autolayer(pronsetar1.usd)+
autolayer(pronsetar2.usd)+
autolayer(pronsetar3.usd)+
autolayer(pronsetar4.usd)+
theme_bw()
Metrics::rmse(sactnetusd_test,(prontar2.usd))
Metrics::rmse(sactnetusd_test, (pronsetar4.usd))
autoplot(sactnetusd_test)+
autolayer(prontar2)+
autolayer(pronsetar3)+
theme_bw()+